perm filename FILL11.F4[P11,LCS] blob sn#595814 filedate 1981-06-18 generic text, type T, neo UTF8
C******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
 	SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
 	DIMENSION IDAT(1)
 	COMMON/DST/BB,CC/FLM/X(400) /ALF/INP,H(35) /RINC/RINC
C ????? HOW BIG MUST X ARRAY BE.  350 IS CURRENT LIMIT IN 'CLEFS'
C X ARRAY CAN PROBABLY BE SHARED WITH SOME OTHER ARRAY.
C H ARRAY HOLDS NUMBER OF VERTICAL SLICES NEEDED AT ANY ONE TIME.
C IDAT IS THE PACKED ARRAY OF POINTS FROM THE 'DRW' PROGRAM.
 	COMMON/PLTR/IPLT,RHT,DIS /LL/LL /STF/RG(8),RSTJ2
 	DATA M2/2/
	DX=DIS
 	RX=RHT
	D=RSTJ2*R6
22	R=RSTJ2*R7
CC	GO TO 1
CC	C=CC
CC	B=BB
CCC  SAVES IT.  IT WILL RETURN LATER.
CC	BB=B/DIS
CC	CC=1000
11	KK=-2
	DO 205 J=1,L
	KK=KK+3
	CALL UNPACK(M,N,IDAT(J))
	X(KK)=(R2+D*M)*DIS
	X(KK+1)=(CENTR+R*N)*RHT
33	X(KK+2)=LL
CC	GO TO 205
CC	X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
C  FOR DISTORTION
205	CONTINUE
	KNT=KK+2
	DIS=1.0
	RHT=DIS
C THESE MUST BE 1.0 IN 'LINES' WHEN FILLING.
	RL=X(1)
	RR=RL
	DO 1 K=1,KNT,3
	IF(X(K+2).EQ.3.)X(K+2)=-1.
	A=X(K)
	IF(X(K+3).EQ.A)X(K+5)=-1.
C VERTICAL LINES WILL BE IGNORED.
	IF(A.LT.RL)RL=A
1	IF(A.GT.RR)RR=A
C GET LEFT AND RIGHT EXTREME LIMITS.
	RL=RL-.5
2	RL=RL+RINC
C SLICE COUNTER
	IF(RL.GE.RR)GO TO 66
	M=0
	DO 3 J=4,KNT,3
	IF(X(J+2).LT.0)GO TO 3
	A=X(J)
	B=X(J-3)
	IF(A.LT.B)GO TO 30
C EXCHANGE A,B
	C=B
	B=A
	A=C
30	IF(A.GE.RL)GO TO 3
	IF(B.LT.RL)GO TO 3
C SKIP IF THIS SLICE IS OUT OF BOUNDS
	M=M+1
	C=X(J-2)
C THESE ARE Y COORDS.
	B=X(J)-X(J-3)
CC	IF(B.NE.0)GO TO 34
CC	H(M)=C
CC	GO TO 3
C GET STARTING POS. OF SLICE
34	A=(X(J+1)-C)*(RL-X(J-3))
	H(M)=A/B+C
C H ARRAY CONTAINS ALL SLICES IN THIS HORIZ. POS.
3	CONTINUE
	IF(M.EQ.0)GO TO 2
C  M=0=SPACE BETWEEN OBJECTS -- NO FILLER
	J=1
5	IF(H(J).GE.H(J+1))GO TO 4
C  SORTS HEIGHTS
	A=H(J)
C EXCHANGE H(J),H(J+1)
	H(J)=H(J+1)
	H(J+1)=A
	IF(J.EQ.1)GO TO 4
	J=J-1
	GO TO 5
4	J=J+1
	IF(J.LT.M)GO TO 5
C GO BACK IF MORE SORTING TO BE DONE
	NN=1
6	A=H(NN)
	B=H(NN+1)
	IF(A-B.LE.1.0)GO TO 7
	CALL LINES(RL,A,3)
	CALL LINES(RL,B,2)
7	NN=NN+2
C SKIP BY 2'S
	IF(NN.LT.M)GO TO 6
	GO TO 2

66	DIS=DX
	RHT=RX
C RESTORE PROPER SIZE FACTORS.
	END
CC DIST4:	JRA 16,6(16)		;5	RETURN
CC	MOVE B			;C  NEXT TO RESET DISTORTION FACT.
CC	MOVEM DST		;	BB=B
CC	MOVE C			;	CC=C
CC	MOVEM DST+1
CC	JRA 16,6(16)		; 	RETURN
CC	END